home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / INTRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-10  |  2.9 KB  |  143 lines
  1. { Programmed By :  A.Serdar HAZAR   for  ─=≡ Programlama Sanati ≡=-  }
  2. uses dos,crt,unit1,unit2;
  3. type
  4.  color          = record
  5.                    r,g,b : byte;
  6.                   end;
  7.  
  8. var
  9.  i,x            : word;
  10.  gd,gm          : integer;
  11.  regs           : registers;
  12.  palette        : array[1..256] of color;
  13.  ilk            : color;
  14.  leddurum       : byte absolute $40:$17;
  15.  eski           : byte;
  16.  palet2         : array[1..$300] of byte;
  17.  palet3         : array[1..$300] of byte;
  18.  a,b            : byte;
  19.  
  20. begin
  21.  asm
  22.  mov ah,0
  23.  mov bx,0
  24.  mov si,seg muzik
  25.  mov es,si
  26.  mov si,offset muzik
  27.  end;
  28.  Hscobj;
  29.  
  30.   regs.ax:=$1017;
  31.   regs.bx:=0;
  32.   regs.cx:=256;
  33.   regs.es:=seg(palet2[1]);
  34.   regs.dx:=ofs(palet2[1]);
  35.   intr($10,regs);
  36.  
  37.  for a:=20 downto 0 do
  38.  begin
  39.   for x:=4 to $300 do palet3[x]:=trunc(palet2[x]*a/20);
  40.   regs.ax:=$1012;
  41.   regs.bx:=0;
  42.   regs.cx:=256;
  43.   regs.es:=seg(palet3[1]);
  44.   regs.dx:=ofs(palet3[1]);
  45.   intr($10,regs);
  46.   delay(20);
  47.  end;
  48.  
  49.  asm
  50.   mov ax,13h;
  51.   int 10h
  52.  end;
  53.  move(mem[seg(resim)+2:ofs(resim)],palette,$300);
  54.  move(mem[seg(resim)+2:ofs(resim)],palet2,$300);
  55.  for x:=1 to $300 do palet3[x]:=0;
  56.  regs.ax:=$1012;
  57.  regs.bx:=0;
  58.  regs.cx:=256;
  59.  regs.dx:=ofs(palet3[1]);
  60.  regs.es:=seg(palet3[1]);
  61.  intr($10,regs);
  62.  move(mem[seg(resim)+$32:ofs(resim)],mem[$a000:0],64000);
  63.  for a:=0 to 20 do
  64.  begin
  65.   for x:=1 to $300 do palet3[x]:=trunc(palet2[x]*a/20);
  66.   regs.ax:=$1012;
  67.   regs.bx:=0;
  68.   regs.cx:=256;
  69.   regs.es:=seg(palet3[1]);
  70.   regs.dx:=ofs(palet3[1]);
  71.        intr($10,regs);
  72.  end;
  73.  
  74.  eski:=leddurum;
  75.  
  76.  regs.ax:=$1012;
  77.  regs.bx:=1;
  78.  regs.cx:=255;
  79.  repeat
  80.   i:=random(3);
  81.   if i=0 then begin
  82.                leddurum:=64;
  83.                delay(50);
  84.               end;
  85.   if i=1 then begin
  86.                leddurum:=32;
  87.                delay(50);
  88.               end;
  89.   if i=2 then begin
  90.                leddurum:=16;
  91.                delay(50);
  92.               end;
  93.   ilk:=palette[2];
  94.   move(palette[2],palette[1],sizeof(palette)-1);
  95.   palette[256]:=ilk;
  96.   regs.es:=seg(palette[1]);
  97.   regs.dx:=ofs(palette[1]);
  98.   intr($10,regs);
  99.  until keypressed;readkey;
  100.  
  101.  move(palette[1],palet2[1],$300);
  102.  
  103.  for a:=20 downto 0 do
  104.  begin
  105.   for x:=4 to $300 do palet3[x]:=trunc(palet2[x]*a/20);
  106.   regs.ax:=$1012;
  107.   regs.bx:=0;
  108.   regs.cx:=256;
  109.   regs.es:=seg(palet3[1]);
  110.   regs.dx:=ofs(palet3[1]);
  111.   intr($10,regs);
  112.  end;
  113.  asm
  114.   mov ax,3h;
  115.   int 10h
  116.  end;
  117.  leddurum:=eski;
  118.  regs.ax:=$1010;
  119.  regs.bx:=7;
  120.  regs.ch:=0;
  121.  regs.cl:=0;
  122.  regs.dh:=0;
  123.  intr($10,regs);
  124.  
  125.  gotoxy(1,25);
  126.  writeln('                                ─═ Prizma ═─ ');
  127.  writeln('                     Turkish Amateur Programmers'' Group');
  128.  writeln('                           Coded by A.Serdar HAZAR');
  129.  
  130.  for i:= 0 to 42 do
  131.  begin
  132.   regs.ch:=i;
  133.   regs.cl:=i;
  134.   regs.dh:=i;
  135.   intr($10,regs);
  136.   delay(25);
  137.  end;
  138.  asm
  139.  mov ah,2
  140.  end;
  141.  Hscobj;
  142.  end.
  143.